home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / hk / bas / hkin.bas < prev    next >
Encoding:
BASIC Source File  |  1993-11-30  |  36.9 KB  |  989 lines
  1. 10 '------------------------------------------------------------------
  2. 20 '  HKIN.BAS  Copyrigit(C) T.Komura      / 家計簿システム      /
  3. 30 '                                       /      Version 1      /
  4. 31 '  Version 4.0  1992.06.20-1992.06.28   / 入力･編集プログラム /
  5. 32 '  Version 1.0  1993.01.01 公開バージョン
  6. 33 '  Version 1.1a 1993.01.01 辞書入力追加
  7. 34 '  Version 1.1b 1993.01.01 外部ﾌｧｲﾙによる辞書入力スイッチ
  8. 100 '------------------------------------------------------------------
  9. 140 CLEAR ,,,,,300*1024
  10. 150 DIM CFI$(15)
  11. 170 GOSUB *CONFIGファイルチェック
  12. 190 '
  13. 193 VERN$="1.0" 'バージョンNo.
  14. 200 *初期設定:'--------------------------------------------------------
  15. 210 CMD$="CD "+PRGDRV$:SHELL CMD$
  16. 220 SCREEN@ 0 :COLOR 7,0,0,4:CLS:CONSOLE 0,24,0:MOUSE 0
  17. 230 DIM MSGD%(28000):' 音声メッセージ配列定義 プログラム先頭で定義
  18. 240 LOAD@ FMBDRV$+"\FMP.FMB"
  19. 250 PLAY "@30T150V6":DATX$=DATE$
  20. 260 DIM XB1(3,26),XB2(3,26),YB1(3,26),YB2(3,26),BST(3,26)
  21. 270 DIM DYN$(16),DRM$(16),DYN(16)
  22. 280 DIM WRD$(16,128),WLN(16,128),WRDM(128)
  23. 300 INTERVAL 1                  :'プログラム先頭
  24. 310 ON INTERVAL GOSUB *時計表示 :'プログラム先頭 
  25. 320 GOSUB *ボタン座標読み取り
  26. 330 'CLS:COLOR 7:PRINT int((int(((155-14+1)+7)/8)*(415-131+1)*4+8-1)/8)
  27. 350 DIM CUTN#(795),DICD#(2565),DICT#(1456)
  28. 370 ON ERROR GOTO *ERROR
  29. 380 '
  30. 410 CBMAX=10:'コントロールボタン個数
  31. 1000 *メインルーチン:'･･･････････････････････････････････････････････････
  32. 1005 GOSUB *表紙表示:CONSOLE 0,24,2
  33. 1015 MESN=1:GOSUB *MESDSP
  34. 1020 GOSUB *本日の日付
  35. 1030 GOSUB *日付表示
  36. 1040 MOUSE 1,320,64,1
  37. 1050 GOSUB *指定日データ表示
  38. 1055 IF DICIF=1 THEN GOSUB *DICREAD
  39. 1060 GOSUB *辞書入力スイッチ
  40. 1070 MESN=18:GOSUB *SNDMSG
  41. 1100 *メイン選択
  42. 1110 IF MES2OFF=0 THEN MESN=2:GOSUB *MESDSP
  43. 1130 SWPASS=1:G=1:GOSUB *マウスボタン選択
  44. 1145 IF SWNO>=CBMAX+1 THEN *SSEL
  45. 1150 ON SWNO GOTO *S01,*S02,*S03,*S04,*S05,*S06,*S07,*S08,*S09,*S10
  46. 1160 GOTO 1100:STOP
  47. 3490 '
  48. 3500 *S01:' 1年先 ---------------------------------------------------
  49. 3505  YDEF=+1:MDEF= 0:DDEF= 0: GOTO *YMDRNEW
  50. 3510 *S02:' 1年前 ---------------------------------------------------
  51. 3515  YDEF=-1:MDEF= 0:DDEF= 0: GOTO *YMDRNEW
  52. 3520 *S03:' 1月先 ---------------------------------------------------
  53. 3525  YDEF= 0:MDEF=+1:DDEF= 0: GOTO *YMDRNEW
  54. 3530 *S04:' 1月前 ---------------------------------------------------
  55. 3535  YDEF= 0:MDEF=-1:DDEF= 0: GOTO *YMDRNEW
  56. 3540 *S05:' 1日先 ---------------------------------------------------
  57. 3545  YDEF= 0:MDEF= 0:DDEF=+1: GOTO *YMDRNEW
  58. 3550 *S06:' 1日前 ---------------------------------------------------
  59. 3555  YDEF= 0:MDEF= 0:DDEF=-1: GOTO *YMDRNEW
  60. 3560 '
  61. 3570 *YMDRNEW
  62. 3572  SWNOX=SWNO
  63. 3575  G=1:B=SWNOX:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  64. 3580  IF IPF=0 THEN 3610
  65. 3585  MESN=4:GOSUB *MESDSP
  66. 3590  CMES$="家計簿データ保存実行":GOSUB *確認
  67. 3600  IF SWNO=2 THEN 3610
  68. 3605  GOSUB *家計簿データ保存
  69. 3610  GOSUB *年月日変更
  70. 3620  GOSUB *日付表示
  71. 3650  MESN=6:GOSUB *MESDSP
  72. 3660  GOSUB *指定日データ表示
  73. 3670  IPF=0
  74. 3680  G=1:B=SWNOX:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  75. 3690  GOTO *メイン選択
  76. 3695 '
  77. 3700 *SSEL:'------------------------------------------------------------
  78. 3720  G=1:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  79. 3730  IPNO=B-(CBMAX+1):SWNOX=SWNO
  80. 3740  IF IPNO=0 THEN GOSUB *出来事入力   :GOTO 3900
  81. 3760                 GOSUB *金額･内容入力:GOTO 3900
  82. 3900  IPF=1
  83. 3910  G=1:B=SWNOX:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  84. 3980  MES2OFF=0
  85. 3990  GOTO *メイン選択
  86. 3995 '
  87. 4000 *S07:'取消 --------------------------------------------------------
  88. 4010  G=1:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示 
  89. 4020  MESN=6:GOSUB *MESDSP
  90. 4030  GOSUB *指定日データ表示
  91. 4035  IPF=0
  92. 4040  G=1:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  93. 4050  GOTO *メイン選択
  94. 4060 '
  95. 4500 *S08:'保存 --------------------------------------------------------
  96. 4510  GOSUB *家計簿データ保存
  97. 4580  GOTO *メイン選択
  98. 4590 '
  99. 5000 *S09:'辞書使用スイッチ --------------------------------------------'
  100. 5010  G=1:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  101. 5020  IF DICIF=0 THEN MESN=14 ELSE MESN=15
  102. 5030  GOSUB *MESDSP
  103. 5035  DICIF=1-DICIF
  104. 5036  IF DICIF=1 AND DICEXF=0 THEN GOSUB *DICREAD
  105. 5040  GOSUB *辞書入力スイッチ'
  106. 5050  G=1:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  107. 5060  GOTO *メイン選択
  108. 5070 '
  109. 8940 '
  110. 9000 *S10:'終了････････････････････････････････････････････････････････
  111. 9020 G=1:B=10:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  112. 9030  IF IPF=0 THEN 9110
  113. 9035  MESN=4:GOSUB *MESDSP
  114. 9040  CMES$="家計簿データ保存実行":GOSUB *確認
  115. 9045  IF SWNO=2 THEN 9110
  116. 9050  GOSUB *家計簿データ保存
  117. 9060 '
  118. 9110 MESN=9:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  119. 9120 INTERVAL OFF
  120. 9130 'MOUSE 5:GOSUB *FADEOUT
  121. 9150 CHAIN "HKmain.bas"
  122. 9160 '
  123. 9900 '-------------------------------------------------------------------
  124. 9910 '    ＧＥＮＥＲＡＬ　ＳＵＢ　ＲＯＵＴＩＮＥ
  125. 9920 '-------------------------------------------------------------------
  126. 10000 *CHR1IN:'////////// 1文字入力
  127. 10010  A$=INKEY$:IF A$="" THEN 10010
  128. 10020  A=INSTR(C$,A$)
  129. 10030  IF A=0 THEN MESN=13:GOSUB *SNDMSG:GOTO 10010
  130. 10040  RETURN
  131. 10050 '
  132. 10060 '
  133. 10070 *MESDSP:'////////// メッセージ表示
  134. 10080  RESTORE *MESDAT
  135. 10090  FOR IM=1 TO MESN:READ XM,YM,CM,CB,BM,MES$:NEXT IM
  136. 10100  LOCATE 0,YM:COLOR CB,CB:PRINT SPACE$(79);
  137. 10110  LOCATE XM,YM:COLOR CM,CB:PRINT MES$;
  138. 10120  'IF BM=1 THEN PLAY "L4O4A"
  139. 10130  RETURN
  140. 10140 '
  141. 10200 *MESDAT:'////////// メッセージデータ
  142. 10205 '    XM, YN, CM, CB, BM
  143. 10210 DATA  2, 23,  5,  0,  1 :'--- 01
  144. 10215 DATA "                     - HK version 1.1 - 記入･編集            "
  145. 10220 DATA  2, 23,  7,  0,  0 :'--- 02
  146. 10225 DATA "適当なボタンをマウスカーソルで押して(左ｸﾘｯｸ)ください｡"
  147. 10230 DATA  2, 23,  6,  0,  0 :'--- 03
  148. 10235 DATA "ディスクにこの月の家計簿ファイルがありません｡新しくファイルを作りますか?"
  149. 10240 DATA  2, 23,  6,  0,  1 :'--- 04
  150. 10245 DATA "家計簿データが保存されていません！  保存する--[OK] 保存しない--[NG]"
  151. 10250 DATA  2, 23,  4,  0,  1 :'--- 05
  152. 10255 DATA "★家計簿ファイル新規作成中 !!"
  153. 10260 DATA  2, 23,  4,  0,  1 :'--- 06
  154. 10265 DATA "★家計簿ファイル読み込み中 !!"
  155. 10270 DATA  2, 23,  6,  0,  0 :'--- 07
  156. 10275 DATA "家計簿ファイルが無いため､この月のデータは読み込みできません!"
  157. 10280 DATA  2, 23,  7,  0,  0 :'--- 08
  158. 10285 DATA "このデータを家計簿ファイルに書き込んでよろしいですか? [OK],[NG]"
  159. 10290 DATA  2, 23,  5,  0,  1 :'--- 09
  160. 10295 DATA "       ★★★  しばらくお待ちください｡"
  161. 10300 DATA  2, 23,  7,  0,  0 :'--- 10
  162. 10305 DATA "[ファイル記入･訂正] -- 出来事を記入してください｡"
  163. 10310 DATA  2, 23,  7,  0,  0 :'--- 11
  164. 10315 DATA "[ファイル記入･訂正] -- 金額を記入してください｡"
  165. 10320 DATA  2, 23,  7,  0,  0 :'--- 12
  166. 10325 DATA "[ファイル記入･訂正] -- 内容を記入してください｡"
  167. 10330 DATA  2, 23,  4,  0,  1 :'--- 13
  168. 10335 DATA "★ 家計簿データ保存中｡"
  169. 10340 DATA  2, 23,  4,  0,  1 :'--- 14
  170. 10345 DATA "各項目入力時の辞書入力を[ＯＮ]にします｡"
  171. 10350 DATA  2, 23,  4,  0,  1 :'--- 15
  172. 10355 DATA "各項目入力時の辞書入力を[ＯＦＦ]にします｡"
  173. 10360 DATA  2, 23,  4,  0,  1 :'--- 16
  174. 10365 DATA "★ 辞書データ読み込み中  しばらくお待ちください"
  175. 10370 DATA  2, 23,  7,  0,  1 :'--- 17
  176. 10375 DATA "辞書から語句を選んでください｡ "
  177. 10390 '
  178. 10990 '
  179. 11000 *SNDMSG:'  SAVE "SNDMSG.SUB",A
  180. 11005  IF SNDMF=0 THEN RETURN
  181. 11010  '･････････････････  サウンドメッセージ実行サブルーチン  1989.02.04
  182. 11020  '                   入力=MESN (メッセージNo.)
  183. 11030  '
  184. 11070  IF MESN>36 THEN *RETURN_SNDMSG 
  185. 11080  RESTORE *MSGNAM
  186. 11090  FOR IMSG=1 TO MESN
  187. 11100    READ MSGD$
  188. 11110  NEXT IMSG
  189. 11120  MSGFN$=SNDDRV$+"\"+MSGD$+"_F.SND"
  190. 11130  LOAD@ MSGFN$,MSGD%
  191. 11140  PCMPLAY MSGD%
  192. 11150 *RETURN_SNDMSG :WAIT SWAIT:RETURN
  193. 11160 *MSGNAM :'////////// .SND File Name Data
  194. 11170 DATA "OHA1"   :'  1 おはよう
  195. 11180 DATA "KONN"   :'  2 こんにちわ
  196. 11190 DATA "KONBAN" :'  3 こんばんわ
  197. 11200 DATA "GOKRO1" :'  4 ごくろうさん
  198. 11210 DATA "GOKRO2" :'  5 ごくろうさま
  199. 11220 DATA "OTUKA"  :'  6 お疲れさま
  200. 11230 DATA "OMATA"  :'  7 おまたせ
  201. 11240 DATA "ARIGA2" :'  8 ありがとう
  202. 11250 DATA "RUNRUN" :'  9 るんるん
  203. 11260 DATA "DAMEDE" :' 10 だめでしょう
  204. 11270 DATA "IIDE1"  :' 11 いいですか
  205. 11280 DATA "NANISI" :' 12 なにしてるの
  206. 11290 DATA "DAMEDA" :' 13 だめだめ
  207. 11300 DATA "OWARI"  :' 14 終わりました
  208. 11310 DATA "SIBA"   :' 15 しばらくお待ち下さい
  209. 11320 DATA "YOROSI" :' 16 よろしいですか
  210. 11330 DATA "TYANTO" :' 17 ちゃんとしなさい
  211. 11340 DATA "ERANDE" :' 18 選んでください
  212. 11350 DATA "KAKNIN" :' 19 確認して下さい
  213. 11360 DATA "NYURYO" :' 20 入力してください
  214. 11370 DATA "IRA"    :' 21 いらっしゃいませ 
  215. 11380 DATA "OYASUM" :' 22 おやすみ
  216. 11390 DATA "ARIGA3" :' 23 ありがとうございました
  217. 11400 DATA "TYOTO"  :' 24 ちょっと待って
  218. 11410 DATA "DAMEYO" :' 25 駄目よ
  219. 11420 DATA "YAMETE" :' 26 やめて
  220. 11430 DATA "TIGAU"  :' 27 ちがうよ
  221. 11440 DATA "PINPON" :' 28 ぴんぽーん
  222. 11450 DATA "BUU"    :' 29 ぶー
  223. 11460 DATA "MOUII"  :' 30 もういいよう  
  224. 11470 DATA "DEKITA" :' 31 できたよー
  225. 11480 DATA "IIDE2"  :' 32 いいですか（２）
  226. 11490 DATA "YOSI"   :' 33 よしなさい
  227. 11500 DATA "OYOSI"  :' 34 およしなさい
  228. 11510 DATA "YAMENA" :' 35 やめなさい
  229. 11520 DATA "GOMEN"  :' 36 ごめん
  230. 11530 '                                    
  231. 12000 '////////// 年月日入力 & 曜日表示
  232. 12010 '                    
  233. 12045 *週検索
  234. 12050 DATA "日",2,"月",0,"火",0,"水",0,"木",0,"金",0,"土",5
  235. 12060 GOSUB *WEEKN:RESTORE 12050:FOR IW=0 TO WK:READ WKM$,CW:NEXT IW
  236. 12080 RETURN
  237. 12090 '
  238. 12450 *WEEKN :'////////// 週NO.検索
  239. 12460 U=0    :'････････････････････････ Input; YR MN   Output; WK DN
  240. 12470 IF YR/4-INT(YR/4)=0 THEN U=1
  241. 12480 DATA 31,28,31,30,31,30,31,31,30,31,30,31
  242. 12490 DATA 31,29,31,30,31,30,31,31,30,31,30,31
  243. 12500 IF U=0 THEN RESTORE 12480 ELSE RESTORE 12490
  244. 12505 IF MN=1 THEN MDN=0:MNDN=31:GOTO 12520
  245. 12510 MDN=0:FOR IWEKN=1 TO MN-1:READ DN:MDN=MDN+DN:NEXT IWEKN
  246. 12515 READ MNDN:'当月の日数
  247. 12520 YDN#=MDN+YR*365+INT((YR+3)/4)+5+DY-1
  248. 12530 WK=(YDN#/7-INT(YDN#/7))*7
  249. 12540 RETURN
  250. 13000 '/////////////////////////////////////////////////////////////////
  251. 13001 ' LKEYIN   v1.1a 全角文字移動改良              1993.02.12 T.Komura
  252. 13002 '--------- v1.2  挿入モードの変更他全面bugFIX  1993.08.04 T.Komura
  253. 13003 '
  254. 13010 *LKEYIN  :'･･･････････ 1 行全角文字入力サブルーチン
  255. 13011 '   入力 = LX,LY : 表示開始座標       出力 = LMG$ : 入力後の文字列
  256. 13012 '          LM$   : 初期文字列
  257. 13013 '          LC    : 表示文字色
  258. 13014 '          LL    : 最大文字数
  259. 13015 '          LINS  : 挿入ﾓｰﾄﾞ=1
  260. 13016 '
  261. 13020  LCSRCL=1:LLINCL=6
  262. 13030 '           CR   MR   ML  INS  DEL   BS  CAN
  263. 13040  LMSX=MOUSE(0):LMSY=MOUSE(1):MOUSE 5      :'v1.1a
  264. 13050  CC$=CHR$(&H0D,&H1C,&H1D,&H12,&H7F,&H08,&H18)
  265. 13060  LMG$=SPACE$(LL):LMGD$=SPACE$(LL)
  266. 13070  LA$=INKEY$:IF LA$<>"" THEN 13070
  267. 13080  IF LINS=1 THEN CWDT=1 ELSE CWDT=7
  268. 13090  LCSR=0:LCSRX=LCSR:GOSUB *LCSRDX
  269. 13100  LOCATE LX,LY:COLOR LC:PRINT LM$ '       ･･････････ 初期文字列表示
  270. 13110  LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  271. 13120  LMX$=LEFT$(LM$+SPACE$(LL),LL)
  272. 13130  GOSUB *LMREAD
  273. 13140 *IN1C:'                                  ･･････････ 1 文字入力
  274. 13150  LA$=INKEY$:IF LA$="" THEN 13150
  275. 13160  ALA=ASC(LA$):CLA=INSTR(CC$,LA$)
  276. 13170  IF CLA=0 THEN 13190
  277. 13180  ON CLA GOTO *CR,*MR,*ML,*INS,*DEL,*BS,*CAN
  278. 13190  IF KANF=1 THEN *KANJI
  279. 13200  IF ALA<&H20 THEN BEEP:GOTO *IN1C
  280. 13210  IF ALA>=&H20 AND ALA<&H80 THEN *ANK
  281. 13220  IF ALA>=&HA0 AND ALA<&HE0 THEN *ANK
  282. 13230  GOTO *KANJI
  283. 13240 *ANK :'                                  ･･････････ ANK 文字入力
  284. 13250  IF LINS=1 THEN 13270
  285. 13260  MID$(LMX$,LCSR+1,1)=LA$:GOTO 13280
  286. 13270  LMX$=LEFT$(LMX$,LCSR)+LA$+RIGHT$(LMX$,LL-LCSR)
  287. 13280  GOSUB *LCSRINC
  288. 13290  GOSUB *LMREAD1:GOSUB *LMXDSP
  289. 13300  GOTO *IN1C
  290. 13310 *KANJI :'                                ･･････････ 漢字文字入力
  291. 13320  ON KANF+1 GOTO 13330,13360
  292. 13330  KANF=1:KANW$="":KANW$=LA$
  293. 13340    IF LCSR+1>=LL THEN KANF=0:BEEP
  294. 13350    GOSUB *LCSRD:GOTO *IN1C
  295. 13360  KANF=0:KANW$=KANW$+LA$
  296. 13370    IF LINS=1 THEN 13390
  297. 13380    MID$(LMX$,LCSR+1,2)=KANW$:GOTO 13400
  298. 13390    LMX$=LEFT$(LMX$,LCSR)+KANW$+RIGHT$(LMX$,LL-LCSR)
  299. 13400    GOSUB *LCSR2INC
  300. 13410    GOSUB *LMREAD1:GOSUB *LMXDSP
  301. 13420  GOTO *IN1C
  302. 13430 *CR :GOSUB *LMREAD:GOSUB *LCSRDX         '////////// End
  303. 13440  LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  304. 13450  MOUSE 0: MOUSE 1,LMSX,LMSY,1     :'v1.1a
  305. 13460 RETURN:'----------------------------------------------------------
  306. 13470 *MR :GOSUB *LMREAD2                      '////////// Right
  307. 13480      IF LMGF$="1" THEN GOSUB *LCSR2INC:GOTO *IN1C
  308. 13490                        GOSUB *LCSRINC :GOTO *IN1C
  309. 13500 *ML :GOSUB *LMREAD2                      '////////// Left
  310. 13510      IF LMGB$="2" THEN GOSUB *LCSR2DEC:GOTO *IN1C
  311. 13520                        GOSUB *LCSRDEC :GOTO *IN1C
  312. 13530 *INS:GOSUB *LCSRDX:LINS=1-LINS           '////////// Insert
  313. 13540      IF LINS=1 THEN CWDT=1 ELSE CWDT=7
  314. 13550      GOSUB *LCSRDX                    :GOTO *IN1C
  315. 13560 *DEL:GOSUB *LMREAD:LMX$=LEFT$(LMG$,LCSR) '////////// Delete
  316. 13570      IF LMGF$="1" THEN LDEF=2 ELSE LDEF=1
  317. 13580      LMX$=LMX$+MID$(LMG$,LCSR+LDEF+1,LL-LCSR-LDEF)+"  "
  318. 13590      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  319. 13600 *BS :GOSUB *LMREAD                       '////////// BackSpace
  320. 13610      IF LCSR=0 THEN GOTO *IN1C
  321. 13620      IF LMGB$="2" THEN GOSUB *LCSR2DEC:LDEF=2:GOTO 13640
  322. 13630                        GOSUB *LCSRDEC :LDEF=1:GOTO 13640
  323. 13640      LMX$=LEFT$(LMG$,LCSR)+RIGHT$(LMG$,LL-LCSR-LDEF)+"  "
  324. 13650      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  325. 13660 *CAN :LMX$=SPACE$(LL)                    '////////// Clear
  326. 13670      GOSUB *LMXDSP:LCSR=0:GOSUB *LCSRD
  327. 13680      GOSUB *LMREAD                    :GOTO *IN1C
  328. 13690 *LMREAD:                                 '////////// Disp Char Read 
  329. 13700      LMGFX$=MID$(LMGDX$,LCSR+1,1)
  330. 13710      IF LMGFX$="2" OR LMGF$="2" THEN MID$(LMX$,LCSR+1,1)=" "
  331. 13720 *LMREAD1:LMGD$=""
  332. 13730          FOR II=1 TO KLEN(LMX$)
  333. 13740            LMG=KTYPE(LMX$,II)
  334. 13750            IF LMG=0 THEN LMD$="0" ELSE LMD$="12"
  335. 13760            LMGD$=LMGD$+LMD$
  336. 13770          NEXT II
  337. 13780          IF LEN(LMGD$)<=LL THEN 13800
  338. 13790          LMGD$=LEFT$(LMGD$,LL):LMX$=LEFT$(LMX$,LL)
  339. 13800          IF RIGHT$(LMGD$,1)<>"1" THEN 13820
  340. 13810          MID$(LMGD$,LL,1)="0":MID$(LMX$,LL,1)=" "
  341. 13820 *LMREAD2:LMGF$=MID$(LMGD$,LCSR+1,1)
  342. 13830          IF LCSR=0 THEN LMGB$="0" ELSE LMGB$=MID$(LMGD$,LCSR,1)
  343. 13840          LMG$=LMX$:LMGDX$=LMGD$
  344. 13850          RETURN
  345. 13860 *LCSRD :LXC=8*(LX+LCSR) :LYC=LY*19:GOSUB *LCSRL: '//// Csr Disp
  346. 13870 *LCSRDX:LXC=8*(LX+LCSRX):LYC=LY*19:GOSUB *LCSRL: '//// Csr Erace
  347. 13880         LCSRX=LCSR:RETURN
  348. 13890 *LCSRL :LINE(LXC,LYC+0)-(LXC+CWDT,LYC+14),XOR,LCSRCL,BF:RETURN
  349. 13900 *LCSRINC :LCSR=LCSR+1:IF LCSR>=LL THEN LCSR=LL-1
  350. 13905           GOSUB *LCSRD:RETURN
  351. 13910 *LCSR2INC:LCSR=LCSR+2:IF LCSR>=LL THEN LCSR=LL-2
  352. 13915           GOSUB *LCSRD:RETURN
  353. 13920 *LCSRDEC :LCSR=LCSR-1:IF LCSR<0 THEN LCSR=0
  354. 13925           GOSUB *LCSRD:RETURN
  355. 13930 *LCSR2DEC:LCSR=LCSR-2:IF LCSR<0 THEN LCSR=LCSR+2
  356. 13935           GOSUB *LCSRD:RETURN
  357. 13940 *LMXDSP  :LOCATE LX,LY:COLOR LC:PRINT LMX$;:RETURN
  358. 13950 '-------------------------------------------------------------------
  359. 15000 '
  360. 15010 '  SAVE"TCLOCK.sub"             :'   組み込み型 アナログ時計 V1.1
  361. 15020 '                                       1991.05 T.KOMURA 
  362. 15030 '--------------------------------------------------------------------
  363. 15040 '
  364. 15220 *時計表示:'///////////////////////////////////
  365. 15230 XCLK0=572:YCLK0=22:CLKR=16:PI=3.1415!
  366. 15240 TIMEX$=TIME$:IF DATE$<>DATX$ THEN GOSUB *本日の日付
  367. 15250 TSC$=MID$(TIMEX$,7,2):SCR=2*PI*(VAL(TSC$)/60)
  368. 15260 TMN$=MID$(TIMEX$,4,2):MNR=2*PI*(VAL(TMN$)/60)
  369. 15270 THR$=LEFT$(TIMEX$,2) :HRR=2*PI*((VAL(THR$)*60+VAL(TMN$))/720)
  370. 15280 GOSUB *短針表示
  371. 15290 GOSUB *長針表示
  372. 15300 GOSUB *秒針表示
  373. 15310 CLOCKINIT=1:DATX$=DATE$
  374. 15320 RETURN
  375. 15330 '
  376. 15340 *短針表示
  377. 15350 XHD1=XCLK0+(CLKR-8)*SIN(HRR):XHD2=XCLK0
  378. 15360 YHD1=YCLK0-(CLKR-8)*COS(HRR):YHD2=YCLK0
  379. 15370 IF CLOCKINIT=0 THEN 15400
  380. 15380 IF SCR<>0 THEN 15420
  381. 15390 LINE(XHD1X,YHD1X)-(XHD2X,YHD2X),XOR,6
  382. 15400 LINE(XHD1 ,YHD1 )-(XHD2 ,YHD2 ),XOR,6
  383. 15410 XHD1X=XHD1:YHD1X=YHD1:XHD2X=XHD2:YHD2X=YHD2
  384. 15420 RETURN
  385. 15430 *長針表示
  386. 15440 XMD1=XCLK0+(CLKR-2)*SIN(MNR):XMD2=XCLK0
  387. 15450 YMD1=YCLK0-(CLKR-2)*COS(MNR):YMD2=YCLK0
  388. 15460 IF CLOCKINIT=0 THEN 15490
  389. 15470 IF SCR<>0 THEN 15510
  390. 15480 LINE(XMD1X,YMD1X)-(XMD2X,YMD2X),XOR,7
  391. 15490 LINE(XMD1 ,YMD1 )-(XMD2 ,YMD2 ),XOR,7
  392. 15500 XMD1X=XMD1:YMD1X=YMD1:XMD2X=XMD2:YMD2X=YMD2
  393. 15510 RETURN
  394. 15520 *秒針表示
  395. 15530 XSD1=XCLK0+(CLKR)*SIN(SCR):XSD2=XCLK0:'+(CLKR-10)*SIN(SCR)
  396. 15540 YSD1=YCLK0-(CLKR)*COS(SCR):YSD2=YCLK0:'-(CLKR-10)*COS(SCR)
  397. 15550 IF CLOCKINIT=0 THEN 15570
  398. 15560 LINE(XSD1X,YSD1X)-(XSD2X,YSD2X),XOR,4
  399. 15570 LINE(XSD1 ,YSD1 )-(XSD2 ,YSD2 ),XOR,4
  400. 15580 XSD1X=XSD1:YSD1X=YSD1:XSD2X=XSD2:YSD2X=YSD2
  401. 15590 RETURN
  402. 16000 '
  403. 19000 '
  404. 19010 '//////////////////////////////////////////////////////////////
  405. 19020 *ERROR:'      エラー処理サブルーチン V1.10   1990.11.08 T.Komura
  406. 19030 '             
  407. 19040 '
  408. 19050 IF ERR=53 THEN *IOERR
  409. 19060 IF ERR=63 THEN *FILNOF
  410. 19070 IF ERR=67 THEN *DSKFUL
  411. 19080 IF ERR=71 THEN *DSKUNF 
  412. 19090 IF ERR=72 THEN *DSKOFF
  413. 19100 IF ERR=73 THEN *DSKWP
  414. 19110 ERMES$="エラー行:"+STR$(ERL)+" エラー番号:"+STR$(ERR)+" 発生"
  415. 19120 GOSUB *ERMSG
  416. 19130 STOP
  417. 19140 '////////// エラー処理
  418. 19150 *IOERR
  419. 19160 ERMES$="ﾌﾟﾘﾝﾀｰが準備されていません｡ ﾌﾟﾘﾝﾀｰをセット後､"
  420. 19170 GOSUB *ERMSG:RESUME
  421. 19180 *DSKFUL
  422. 19190 ERMES$="ディスクが満杯です｡ 交換後､"
  423. 19200 GOSUB *ERMSG:RESUME
  424. 19210 *DSKUNF
  425. 19220 ERMES$="このディスクは使用出来ません｡処理を中断します｡ "
  426. 19230 GOSUB *ERMSG:RESUME
  427. 19240 *DSKOFF
  428. 19250 ERMES$="ディスク装置が準備されていません｡ディスクをセット後､"
  429. 19260 GOSUB *ERMSG:RESUME
  430. 19270 *DSKWP
  431. 19280 ERMES$="ディスクが書き込み禁止になっています｡解除後､"
  432. 19290 GOSUB *ERMSG:RESUME
  433. 19300 *FILNOF
  434. 19310 ERMES$="ファイルが見つかりません｡ディスクを交換後､"
  435. 19320 GOSUB *ERMSG:RESUME
  436. 19330 '
  437. 19340 *ERMSG:'////////// エラーメッセージ
  438. 19350 LOCATE 2,23:COLOR 2,0
  439. 19355 PRINT SPACE$(77);
  440. 19359 LOCATE 2,23:COLOR 2,0
  441. 19360 PRINT ERMES$;"[実行]キーを押してね！";
  442. 19370 COLOR 7,0:MESN=19:GOSUB *SNDMSG
  443. 19380 ERRA$=INKEY$:IF ERRA$="" THEN 19380
  444. 19390 IF ERRA$<>CHR$(&H0D) THEN 19380
  445. 19400 LOCATE 3,23:COLOR 6,0
  446. 19410 PRINT "エラー処理を終わります｡";SPACE$(52);
  447. 19420 RETURN
  448. 19430 '
  449. 19440 '
  450. 19450 '
  451. 20000 '------------------------------------------------------------------
  452. 20010 ' ＣＵＳＴＯＭ　ＳＵＢ　ＲＯＵＴＩＮＥ FOR "DOQSO.BAS"
  453. 20020 '------------------------------------------------------------------
  454. 20100 *表紙表示
  455. 20105  LOAD@ TIFDRV$+"\HKIN.TIF",(0,0)
  456. 20110  FOR II=1 TO 15
  457. 20115    X=100:Y=134+19*(II-1)
  458. 20120    SYMBOL(X,Y),CFI$(II),.8!,.8!,0,,,,4
  459. 20125  NEXT II
  460. 20130  'GOSUB *初期表示ポイント検出
  461. 20145  INTERVAL ON
  462. 20160  RETURN
  463. 20190 '
  464. 20200 *本日の日付
  465. 20210  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  466. 20212  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  467. 20214  TY$=RIGHT$(STR$(TY),4)
  468. 20220  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  469. 20230  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  470. 20250  YR=TY:MN=TM:DY=TD:GOSUB *週検索:IF CW=0 THEN CW=7
  471. 20260  TYMD$=TY$+"年"+TM$+"月"+TD$+"日"+"   曜日"
  472. 20265  COLOR 7,0:LOCATE 46,1:PRINT TYMD$
  473. 20270  COLOR CW:LOCATE 61,1:PRINT WKM$
  474. 20280  RETURN
  475. 20290 '
  476. 20300 *日付表示
  477. 20310  YR$=RIGHT$(STR$(YR),4)
  478. 20315  NBN=4:NBA$=YR$:GOSUB *数字漢字変換:KYR$=NBK$
  479. 20320  MN$=RIGHT$(STR$(100+MN),2)
  480. 20325  NBN=2:NBA$=MN$:GOSUB *数字漢字変換:KMN$=NBK$
  481. 20330  DY$=RIGHT$(STR$(100+DY),2)
  482. 20335  NBN=2:NBA$=DY$:GOSUB *数字漢字変換:KDY$=NBK$
  483. 20340  GOSUB *週検索:IF CW=0 THEN CW=7
  484. 20350  DYMD$=KYR$+"       "+KMN$+"       "+KDY$+" "
  485. 20360  COLOR 6,0:LOCATE 12,3:PRINT DYMD$;
  486. 20370  COLOR CW,0:PRINT WKM$;
  487. 20375  IYM$=YR$+MN$
  488. 20380  RETURN
  489. 20390 '
  490. 20400 *指定日データ表示
  491. 20410  GOSUB *HKISRC
  492. 20420  IF FIDX=0 THEN 20450
  493. 20430  GOSUB *データ表示
  494. 20440  RETURN
  495. 20450  GOSUB *新規ファイル作成
  496. 20480  RETURN
  497. 20490  '
  498. 20495  '
  499. 20500 *データ表示
  500. 20510  RDY=DY:GOSUB *HKDGET
  501. 20520  LOCATE 12,5:COLOR 7:PRINT DEV$
  502. 20530  FOR II=1 TO 15
  503. 20532    LOCATE 20,II+6:COLOR 0:PRINT DYN$(II);"  ";DRM$(II);
  504. 20534  NEXT II
  505. 20540  IF MID$(IMAK$,DY,1)<>" " THEN 20550
  506. 20545  LOCATE 76,5:COLOR 4:PRINT "  ":GOTO *合計表示
  507. 20550  LOCATE 76,5:COLOR 4:PRINT "★":GOTO *合計表示
  508. 20555 *合計表示
  509. 20560  LOCATE 68, 8:COLOR 1:PRINT DIYN$
  510. 20562  LOCATE 68,12:COLOR 0:PRINT DBYN$
  511. 20564  LOCATE 68,20:COLOR 2:PRINT DOYN$
  512. 20580  RETURN
  513. 20590 '
  514. 20600 *年月日変更
  515. 20601  GOSUB *WEEKN
  516. 20602  DY=DY+DDEF
  517. 20604  IF DY<1 THEN MN=MN-1:GOSUB *WEEKN:DY=MNDN
  518. 20606  IF DY>MNDN THEN MN=MN+1:DY=1
  519. 20610  MN=MN+MDEF
  520. 20620  IF MN<1 THEN MN=12+MN:YR=YR-1
  521. 20630  IF MN>12 THEN MN=MN-12:YR=YR+1
  522. 20640  YR=YR+YDEF
  523. 20650  IF YR<0 THEN YR=10000+YR
  524. 20660  IF YR>9999 THEN YR=YR-10000
  525. 20665  GOSUB *WEEKN:IF DY>MNDN THEN DY=MNDN
  526. 20668  DY$=RIGHT$(STR$(100+DY),2)
  527. 20670  MN$=RIGHT$(STR$(100+MN),2)
  528. 20680  YR$=RIGHT$(STR$(10000+YR),4)
  529. 20690  RETURN
  530. 20695 '
  531. 20700 *新規ファイル作成
  532. 20710  FOR II=5 TO 22:LOCATE 12,II:PRINT SPACE$(66):NEXT II
  533. 20720  IF (YR*12+MN)=(YRM*12+MNM+1) THEN 20750:'----次月チェック
  534. 20730  MESN=7:GOSUB *MESDSP:MESN=25:GOSUB *SNDMSG
  535. 20740  FOR I=1 TO 5000:NEXT I:RETURN
  536. 20750  MESN=3:GOSUB *MESDSP:'-----------------------確認
  537. 20760  CMES$="["+YR$+"年"+MN$+"月]ファイル新規作成"
  538. 20770  GOSUB *確認
  539. 20780  ON SWNO GOTO 20800,20870
  540. 20800  MESN=5:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  541. 20810  IYM$=YR$+MN$:IMAK$=SPACE$(32):'--------------IDX追加
  542. 20820  RI=IR+1:GOSUB *HKIPUT
  543. 20830  DEV$=SPACE$(64):DDM$=SPACE$(32):'------------ファイル作成
  544. 20835  FOR JJ=1 TO 16:DYN$(JJ)=SPACE$(10):DRM$(JJ)=SPACE$(32):NEXT JJ
  545. 20840  FOR RDY=1 TO 31
  546. 20845    LOCATE 70,23:COLOR 4:PRINT RIGHT$(STR$(RDY),2);" / 31";
  547. 20850    GOSUB *HKDPUT
  548. 20860  NEXT RDY:MESN=14:GOSUB *SNDMSG
  549. 20870  RETURN
  550. 20880 '
  551. 21000 *出来事入力
  552. 21010  MESN=10:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  553. 21020  LX=12:LY=5:LC=5:LL=64:LM$=DEV$:LINS=1
  554. 21040  LOCATE LX,LY:COLOR LC:PRINT LM$:GOSUB *LKEYIN
  555. 21050  DEV$=LMG$
  556. 21060  LOCATE LX,LY:COLOR  7:PRINT DEV$
  557. 21070  RETURN
  558. 21080 '
  559. 21100 *金額･内容入力
  560. 21110  MESN=11:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  561. 21120  LX=20:LY=6+IPNO:LC=1:LL=10:LM$=DYN$(IPNO):LINS=0
  562. 21140  LOCATE LX,LY:COLOR LC:PRINT LM$:GOSUB *LKEYIN
  563. 21150  DYN$=LMG$
  564. 21155  DYN$(IPNO)=RIGHT$(SPACE$(10)+STR$(VAL(DYN$)),10)
  565. 21160  LOCATE LX,LY:COLOR 0:PRINT DYN$(IPNO)
  566. 21170 '
  567. 21180  IF DICIF=1 THEN GOSUB *辞書入力 ELSE 21210
  568. 21185  IF ENDF=1 THEN 21210
  569. 21190  IF ENDF=0 THEN 21300
  570. 21210  MESN=12:GOSUB *MESDSP
  571. 21220  LX=32:LY=6+IPNO:LC=1:LL=32:LM$=DRM$(IPNO):LINS=1
  572. 21240  LOCATE LX,LY:COLOR LC:PRINT LM$:GOSUB *LKEYIN
  573. 21250  DRM$(IPNO)=LMG$
  574. 21260  LOCATE LX,LY:COLOR 0:PRINT DRM$(IPNO)
  575. 21280 '
  576. 21300  GOSUB *HKDCAL
  577. 21310  GOSUB *合計表示
  578. 21320  RETURN
  579. 21330 '
  580. 21900 '
  581. 22000 *家計簿データ保存
  582. 22010  G=1:B=8:BST(G,B)=1:GOSUB *ボタンON_OFF表示 
  583. 22020  MESN=13:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  584. 22030  RDY=DY:GOSUB *HKDPUT
  585. 22040  MID$(IMAK$,DY,1)="*"
  586. 22045  MID$(IMAK$,32,1)=" "
  587. 22050  GOSUB *HKIPUT
  588. 22060  IPF=0
  589. 22065  G=1:B=8:BST(G,B)=0:GOSUB *ボタンON_OFF表示 
  590. 22070  RETURN
  591. 22080 '
  592. 23000 *辞書データ枠表示
  593. 23020  GET@A(14,131)-(155,415),DICD#
  594. 23030  LOAD@ TIFDRV$+"\DICD.TIF",(14,131)
  595. 23035  DEF FONT "システム   12ﾄﾞｯﾄ": SYMBOL(25,137),CFI$(IPNO),.8!,.75!,0
  596. 23040  GET@A(20,186)-(116,409),DICT#
  597. 23050  RETURN
  598. 23060 *辞書データ枠消去
  599. 23070  PUT@A(14,131)-(155,415),DICD#
  600. 23075  DEF FONT "システム   16ﾄﾞｯﾄ"
  601. 23080  RETURN
  602. 23090 '
  603. 23100 *辞書入力スイッチ
  604. 23120  IF DICIF=0 THEN DICSC=0 ELSE DICSC=4
  605. 23130  LINE(454,60)-(455,70),PSET,DICSC,BF
  606. 23140  WAIT SWAIT
  607. 23150  RETURN
  608. 23160 '
  609. 23200 *辞書データ表示
  610. 23220  PUT@A(20,186)-(116,409),DICT#
  611. 23230  LINE(119,136)-(147,148),PSET,0,BF
  612. 23240  WPAGE=INT((WSP-1)/16)+1
  613. 23245  MPAGE=INT((WRDM(IPNO)-1)/16)+1
  614. 23250  WPG$=RIGHT$(STR$(WPAGE),1)+"/"+RIGHT$(STR$(MPAGE),1)
  615. 23260  SYMBOL(122,137),WPG$,.75!,.75!,4,,,,2
  616. 23320  FOR II=0 TO 15
  617. 23330    IF (WSP+II)>WRDM(IPNO) THEN 23360
  618. 23340    WRDX$=LEFT$(WRD$(IPNO,WSP+II),14)
  619. 23345    IF KLEFT$(WRDX$,1)="★" THEN WRDDC=4 ELSE WRDDC=7
  620. 23350    SYMBOL(22,187+14*II),WRDX$,.75!,.75!,WRDDC
  621. 23360  NEXT II
  622. 23370  RETURN
  623. 23380 '
  624. 23500 *辞書入力
  625. 23510  GOSUB *辞書データ枠表示
  626. 23515  SPS=INSTR(DRM$(IPNO),"  ")
  627. 23520  IF SPS=1           THEN LMG$=""        :GOTO 23523
  628. 23521  IF SPS>30 OR SPS=0 THEN LMG$=DRM$(IPNO):GOTO 23523
  629. 23522  LMG$=LEFT$(DRM$(IPNO),SPS)
  630. 23523  LX=32:LY=6+IPNO:LC=1:LOCATE LX,LY:COLOR LC:PRINT LMG$
  631. 23525  WSP=1
  632. 23530  GOSUB *辞書データ表示
  633. 23540  MESN=17:GOSUB *MESDSP
  634. 23550  SWPASS=1:G=3:GOSUB *マウスボタン選択
  635. 23560  IF SWNO>5 THEN *WSEL
  636. 23570  ON SWNO GOTO *WS1,*WS2,*WS3,*WS4,*WS5
  637. 23575  GOTO 23550
  638. 23580  '
  639. 23600  *WS4:'--- PAGE INC
  640. 23605   G=3:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  641. 23610   WSP=WSP+16
  642. 23620   IF WSP>WRDM(IPNO) THEN WSP=WSP-16:GOTO 23635
  643. 23630   GOSUB *辞書データ表示
  644. 23635   G=3:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  645. 23640   GOTO 23540
  646. 23650  *WS5:'--- PAGE DEC
  647. 23655   G=3:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  648. 23660   WSP=WSP-16
  649. 23670   IF WSP<1 THEN WSP=WSP+16:GOTO 23685
  650. 23680   GOSUB *辞書データ表示
  651. 23685   G=3:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  652. 23690   GOTO 23540
  653. 23700  *WS3:'--- 手入力
  654. 23710   ENDF=1
  655. 23720   GOTO 23740
  656. 23730  *WS1:'--- 終了
  657. 23735   ENDF=0
  658. 23740   IF RIGHT$(LMG$,1)="･" THEN LMG$=LEFT$(LMG$,LEN(LMG$)-1)
  659. 23742   DRM$(IPNO)=LEFT$(LMG$+SPACE$(32),32)
  660. 23745   LX=32:LY=6+IPNO:LC=0:LOCATE LX,LY:COLOR LC:PRINT DRM$(IPNO)
  661. 23750   G=3:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  662. 23760   G=3:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  663. 23770   G=3:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  664. 23780   GOSUB *辞書データ枠消去
  665. 23790   RETURN
  666. 23800  *WS2:'--- 取消
  667. 23810   G=3:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  668. 23820   LMG$=""
  669. 23830   LX=32:LY=6+IPNO:LC=1:LOCATE LX,LY:COLOR LC:PRINT SPACE$(32)
  670. 23840   G=3:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  671. 23850   GOTO 23540
  672. 23900  *WSEL'--------------
  673. 23910   G=3:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  674. 23912   WSELN=WSP+(SWNO-6)
  675. 23914   IF WSELN>WRDM(IPNO) THEN 23940
  676. 23916   IF KLEFT$(WRD$(IPNO,WSELN),1)="★" THEN 23940
  677. 23920   LMG$=LMG$+WRD$(IPNO,WSELN)+"･"
  678. 23925   IF LEN(LMG$)<=32 THEN 23930
  679. 23926   LMG$=LEFT$(LMG$,33):CHT=KTYPE(KRIGHT$(LMG$,1),1)
  680. 23927   IF CHT=1 THEN LMG$=LEFT$(LMG$,31) ELSE LMG$=LEFT$(LMG$,32)
  681. 23930   LX=32:LY=6+IPNO:LC=1:LOCATE LX,LY:COLOR LC:PRINT LMG$
  682. 23940   G=3:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  683. 23950   GOTO 23540
  684. 29900 '------------------------------------------------------------------
  685. 30130 *ボタン座標読み取り
  686. 30140  RESTORE *ボタン座標:READ SWGN
  687. 30150  FOR G=1 TO SWGN
  688. 30160    READ SWN(G),SMX(G),SMY(G),SMW(G)
  689. 30170    FOR B=1 TO SWN(G)
  690. 30180      READ XB1(G,B),XB2(G,B),YB1(G,B),YB2(G,B)
  691. 30190    NEXT B
  692. 30200  NEXT G
  693. 30210  RETURN
  694. 30220 '
  695. 30230 *ボタンON_OFF表示
  696. 30240  IF BST(G,B)=1 THEN BSC=7:BSB=0:BSA=2:GOTO 30260
  697. 30250                    BSC=0:BSB=7:BSA=5
  698. 30260   CONNECT(XB1(G,B  ),YB2(G,B)  )-(XB2(G,B)  ,YB2(G,B)  )-(XB2(G,B  ),YB1(G,B)  ),BSC,PSET
  699. 30270   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB2(G,B)-1,YB2(G,B)-1)-(XB2(G,B)-1,YB1(G,B)+1),BSC,PSET
  700. 30280   CONNECT(XB1(G,B)  ,YB2(G,B)  )-(XB1(G,B)  ,YB1(G,B)  )-(XB2(G,B)  ,YB1(G,B)  ),BSB,PSET
  701. 30290   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB1(G,B)+1,YB1(G,B)+1)-(XB2(G,B)-1,YB1(G,B)+1),BSB,PSET
  702. 30300   LINE(XB1(G,B)+4,YB1(G,B)+4)-(XB1(G,B)+6,YB1(G,B)+5),PSET,BSA,BF
  703. 30305   IF BST(G,B)=1 THEN SMSGPLAY 0:WAIT 16
  704. 30310  RETURN
  705. 30320 '
  706. 30330 *マウスボタン選択
  707. 30340  SWERC=0
  708. 30350  IF MOUSE(2,0)=0 THEN 30350
  709. 30360  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):SWNO=0
  710. 30370  FOR IMS=1 TO SWN(G)
  711. 30380    IF (X_M>XB1(G,IMS) AND X_M<XB2(G,IMS)) ELSE 30410
  712. 30390    IF (Y_M>YB1(G,IMS) AND Y_M<YB2(G,IMS)) ELSE 30410
  713. 30400    SWNO=IMS:IMS=SWN(G)+1
  714. 30410  NEXT IMS:FOR IM=1 TO 500:NEXT IM
  715. 30420  IF SWNO=0 AND SWPASS=1 THEN GOSUB *シート選択判定:GOTO 30460
  716. 30430  IF SWNO=0 AND SWERC>5  THEN MESN=12:GOSUB *SNDMSG       :GOTO 30350
  717. 30440  IF SWNO=0              THEN SMSGPLAY 3:SWERC=SWERC+1:GOTO 30350
  718. 30460  SWPASS=0
  719. 30470  RETURN
  720. 30480 '
  721. 30500 *数字漢字変換
  722. 30505  NBK$=""
  723. 30510  FOR INBK=1 TO NBN
  724. 30512    NBAX$=MID$(NBA$,INBK,1)
  725. 30514    IF NBAX$=" " THEN NBK$=NBK$+"　":GOTO 30530
  726. 30520    NBK$=NBK$+KNJ$(&H2330+VAL(NBAX$))
  727. 30530  NEXT INBK
  728. 30540  RETURN
  729. 30580 '
  730. 30760 '
  731. 30820 *シート選択判定
  732. 30880  RETURN
  733. 30890 '
  734. 31000 *FADEOUT:CLS 1:CONSOLE 0,24,0
  735. 31010  FOR II=0 TO 15
  736. 31020    PALETTE II,[16*II,16*II,16*II]
  737. 31030  NEXT II
  738. 31040  FOR II=0 TO 255 STEP 5
  739. 31050    FOR JJ=0 TO 15:KK=16*JJ+II*(255-16*JJ)/255
  740. 31054      PALETTE JJ,[KK,KK,KK]
  741. 31056    NEXT JJ
  742. 31060  NEXT II
  743. 31070  RETURN
  744. 31080 '
  745. 31200 *確認
  746. 31205  LOCATE 27,3:PRINT SPACE$(52)
  747. 31210  GET@A(214,50)-(630,79),CUTN#
  748. 31220  LOAD@ TIFDRV$+"\CAUTION.TIF",(214,50)
  749. 31225  PLAY "o6l4ce"
  750. 31230  FOR II=1 TO 4
  751. 31232    LOCATE 40,3:COLOR 6:PRINT CMES$;:'28chr
  752. 31234    WAIT SWAIT/10
  753. 31236    LOCATE 40,3:PRINT SPACE$(28)
  754. 31237    WAIT SWAIT/10
  755. 31238  NEXT II
  756. 31239  LOCATE 40,3:COLOR 7:PRINT CMES$;:MESN=19:GOSUB *SNDMSG:'28chr
  757. 31240  G=2:GOSUB *マウスボタン選択
  758. 31245  G=2:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  759. 31250  LOCATE 40,3:PRINT SPACE$(28)
  760. 31260  WAIT SWAIT/5
  761. 31270  PUT@A(214,50)-(630,79),CUTN#
  762. 31272  GOSUB *日付表示
  763. 31275  RETURN
  764. 31280 '
  765. 35000 *HKIOPN:'---------- インデックスファイルオープン
  766. 35005  DRV$=LEFT$(DATDRV$,2)
  767. 35010  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35020
  768. 35015  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  769. 35020  FLN$=DRV$+"(38)"+PATH$+"\HLIDX.DAT"
  770. 35030  OPEN "R",#2,FLN$
  771. 35040  FIELD #2,6 AS I$(1),32 AS I$(2)
  772. 35050  IR=LOF(2)
  773. 35060  RETURN
  774. 35070 '
  775. 35100 *HKDOPN:'---------- 家計簿データファイルオープン
  776. 35105  DRV$=LEFT$(DATDRV$,2)
  777. 35110  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35120
  778. 35115  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  779. 35120  FLN$=DRV$+"(768)"+PATH$+"\HL"+IYM$+".DAT"
  780. 35130  OPEN "R",#1,FLN$
  781. 35140  FIELD #1,64 AS D$(1),10*16 AS D$(2),32*4 AS D$(3),32*4 AS D$(4),32*4 AS D$(5),32*4 AS D$(6),32 AS D$(7)
  782. 35150  AR=LOF(1)
  783. 35160  RETURN
  784. 35170 '
  785. 36000 *HKISRC:'---------- インデックスファイル検索
  786. 36005  FIDX=0
  787. 36010  GOSUB *HKIOPN
  788. 36020  FOR R=1 TO IR
  789. 36030    GET #2,R
  790. 36040    IF IYM$<>I$(1) THEN 36060
  791. 36050    IYM$=I$(1):IMAK$=I$(2):RI=R:R=IR+1:FIDX=1
  792. 36060  NEXT R
  793. 36062  GET #2,IR
  794. 36064  YRM=VAL(LEFT$(I$(1),4)):MNM=VAL(RIGHT$(I$(1),2))
  795. 36070  CLOSE #2
  796. 36080  RETURN
  797. 36090 '
  798. 36100 *HKIPUT:'---------- インデックスファイル書き込み
  799. 36110  GOSUB *HKIOPN
  800. 36120  LSET I$(1)=IYM$
  801. 36130  LSET I$(2)=IMAK$
  802. 36140  PUT #2,RI
  803. 36150  CLOSE #2
  804. 36160  RETURN
  805. 36170 '
  806. 36200 *HKDGET:'---------- 家計簿データ読み込み
  807. 36210  GOSUB *HKDOPN
  808. 36220  R=RDY
  809. 36230  GET #1,R
  810. 36240  DEV$=D$(1)
  811. 36250  FOR II=1 TO 16:DYN$(II   )=MID$(D$(2),(II-1)*10+1,10):NEXT II
  812. 36252  FOR II=1 TO  4:DRM$(II+ 0)=MID$(D$(3),(II-1)*32+1,32):NEXT II
  813. 36253  FOR II=1 TO  4:DRM$(II+ 4)=MID$(D$(4),(II-1)*32+1,32):NEXT II
  814. 36254  FOR II=1 TO  4:DRM$(II+ 8)=MID$(D$(5),(II-1)*32+1,32):NEXT II
  815. 36255  FOR II=1 TO  4:DRM$(II+12)=MID$(D$(6),(II-1)*32+1,32):NEXT II
  816. 36256  DDM$=D$(7)
  817. 36260  GOSUB *HKDCAL
  818. 36280  CLOSE #1
  819. 36290  RETURN
  820. 36295 '
  821. 36300 *HKDPUT:'---------- 家計簿データ書き込み
  822. 36310  GOSUB *HKDOPN
  823. 36320  R=RDY
  824. 36330  LSET D$(1)=DEV$
  825. 36340  DX$="":FOR II=1 TO 16:DX$=DX$+DYN$(II   ):NEXT II:LSET D$(2)=DX$
  826. 36342  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 0):NEXT II:LSET D$(3)=DX$
  827. 36343  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 4):NEXT II:LSET D$(4)=DX$
  828. 36344  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 8):NEXT II:LSET D$(5)=DX$
  829. 36345  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+12):NEXT II:LSET D$(6)=DX$
  830. 36346  LSET D$(7)=DDM$
  831. 36350  PUT #1,R
  832. 36360  CLOSE #1
  833. 36370  RETURN
  834. 36380 '
  835. 36400 *HKDCAL:'---------- 家計簿金額計算
  836. 36410  FOR II=1 TO 16:DYN(II)=VAL(DYN$(II)):NEXT II
  837. 36420  DIYN=0:FOR II=1 TO 3 :DIYN=DIYN+DYN(II):NEXT II
  838. 36430  DIYN$=RIGHT$(SPACE$(8)+STR$(DIYN),8)
  839. 36440  DBYN=0:FOR II=4 TO 7 :DBYN=DBYN+DYN(II):NEXT II
  840. 36450  DBYN$=RIGHT$(SPACE$(8)+STR$(DBYN),8)
  841. 36460  DOYN=0:FOR II=4 TO 15:DOYN=DOYN+DYN(II):NEXT II
  842. 36480  DOYN$=RIGHT$(SPACE$(8)+STR$(DOYN),8)
  843. 36490  RETURN
  844. 36495 '
  845. 36500 *DICREAD:'---------- 辞書読み込み 'V1.1 1993.07.11
  846. 36505  MESN=16:GOSUB *MESDSP
  847. 36510  FOR II=1 TO 15
  848. 36520    DICNO$=RIGHT$(STR$(100+II),2)
  849. 36530    OPEN "I",#4,DICDRV$+"\HKWRD"+DICNO$+".DIC"
  850. 36540    WRDC=1
  851. 36550    IF EOF(4)<>0 THEN 36600
  852. 36555    INPUT #4,WLN$:WLN(II,WRDC)=VAL(WLN$)
  853. 36560    IF EOF(4)<>0 THEN 36600
  854. 36565    INPUT #4,WFR$:'DUMMY
  855. 36570    IF EOF(4)<>0 THEN 36600
  856. 36575    INPUT #4,WRD$:WRD$(II,WRDC)=WRD$
  857. 36580    WRDC=WRDC+1
  858. 36590    IF WRDC<=128 THEN 36550
  859. 36600    WRDM(II)=WRDC-1
  860. 36610    CLOSE #4
  861. 36620  NEXT II:DICEXF=1
  862. 36630  RETURN
  863. 36640 '
  864. 37190 '
  865. 37290 '
  866. 39000 '//////////////////////////////////////////////////
  867. 39010 *CONFIGファイルチェック'  V1.1 1993.08.04
  868. 39020 '                         FOR HK T.Komura
  869. 39030  OPEN "R",#1,"(1)HK.CFG"
  870. 39040  FIELD #1,1 AS D$
  871. 39050  IF LOF(1)=0 THEN *CFGFE1
  872. 39060  CLOSE
  873. 39070  OPEN "I",#1,"HK.CFG"
  874. 39080  GOSUB *CFGREAD:PRGDRV$=CFG$:'-- PRGDRV$
  875. 39090  GOSUB *CFGREAD:DATDRV$=CFG$:'-- DATDRV$
  876. 39100  GOSUB *CFGREAD:RAMDRV$=CFG$:'-- RAMDRV$
  877. 39110  TIFDRV$=PRGDRV$+"\TIFF"    :'-- TIFDRV$
  878. 39120  GOSUB *CFGREAD:FMBDRV$=CFG$:'-- FMBDRV$
  879. 39130  GOSUB *CFGREAD             :'-- SNDMF
  880. 39140    IF LEFT$(CFG$,5)<>"SNDMF" THEN *CFGFE2
  881. 39150    SNDMF=VAL(RIGHT$(CFG$,1))
  882. 39160  GOSUB *CFGREAD:SNDDRV$=CFG$:'-- SNDDRV$
  883. 39170  GOSUB *CFGREAD             :'-- SWAIT
  884. 39180    IF LEFT$(CFG$,4)<>"WAIT" THEN *CFGFE2
  885. 39190    SWAIT=VAL(RIGHT$(CFG$,LEN(CFG$)-5))
  886. 39200  FOR II=1 TO 15
  887. 39210    GOSUB *CFGREAD:CFI$(II)=CFG$
  888. 39220  NEXT II
  889. 39230  GOSUB *CFGREAD             :'-- DICIF
  890. 39240    IF LEFT$(CFG$,5)<>"DICIF" THEN *CFGFE2
  891. 39250    DICIF=VAL(RIGHT$(CFG$,1))
  892. 39260  GOSUB *CFGREAD             :'-- DICSF
  893. 39270    IF LEFT$(CFG$,5)<>"DICSF" THEN *CFGFE2
  894. 39280    DICSF=VAL(RIGHT$(CFG$,1))
  895. 39290  GOSUB *CFGREAD:DICDRV$=CFG$:'-- DICDRV$
  896. 39300  CLOSE
  897. 39310  RETURN
  898. 39320 '---------------------------------------------
  899. 39330 *CFGFE1
  900. 39340  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルが見当たりません｡ 家計簿を終了します｡"
  901. 39350  CLOSE:WAIT 100:SYSTEM
  902. 39360 *CFGFE2
  903. 39370  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの内容に誤りがあります｡ 家計簿を終了します｡"
  904. 39380  CLOSE:WAIT 100:SYSTEM
  905. 39390 *CFGFE3
  906. 39400  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの項目に不足があります｡ 家計簿を終了します｡"
  907. 39410  CLOSE:WAIT 100:SYSTEM
  908. 39420 *CFGREAD
  909. 39430  IF EOF(1)<>0 THEN *CFGFE3
  910. 39440  LINE INPUT #1,CFG$
  911. 39450  IF LEFT$(CFG$,1)="/" THEN 39430
  912. 39460  RETURN
  913. 39470 '//////////////////////////////////////////////////
  914. 39480 '
  915. 40000 *ボタン座標:'-------------------------------------------------------
  916. 40010 DATA 3   'SWGN        スイッチグループ数 
  917. 40090 '/////////////////////////////
  918. 40100 '-------------------- スイッチグループ[1]
  919. 40110 '    SWN(G),SMX,SMY,SMW
  920. 40120 DATA    26 ,  1,  1, 0
  921. 40130 '    XB1 XB2 YB1 YB2 SWM$     SMC SWNO.
  922. 40140 DATA 163,182, 56, 73'," ▲   ",7   01
  923. 40150 DATA 183,202, 56, 73'," ▼   ",7   02 
  924. 40160 DATA 251,270, 56, 73'," ▲   ",7   03
  925. 40170 DATA 271,290, 56, 73'," ▼   ",7   04 
  926. 40180 DATA 364,383, 56, 73'," ▲   ",7   05
  927. 40190 DATA 384,403, 56, 73'," ▼   ",7   06
  928. 40200 DATA 515,568, 56, 79',"取  消",1   07
  929. 40210 DATA 569,624, 56, 79',"保  存",1   08
  930. 40215 DATA 415,448, 56, 73',"辞  書",1   09
  931. 40220 DATA 592,630,  3, 41'," END  ",1   10
  932. 40230 DATA  14, 88, 94,116',"出来事",0   11
  933. 40240 DATA  90,155,131,149',"給　与",1   12
  934. 40250 DATA  90,155,150,168',"臨　時",1   13
  935. 40260 DATA  90,155,169,187',"他収入",1   14
  936. 40270 DATA  90,155,188,206',"食　費",0   15
  937. 40280 DATA  90,155,207,225',"生活費",0   16
  938. 40290 DATA  90,155,226,244',"洗濯代",0   17
  939. 40300 DATA  90,155,245,263',"光熱費",0   18
  940. 40310 DATA  90,155,264,282',"被服費",0   19
  941. 40320 DATA  90,155,283,301',"交際費",0   20
  942. 40330 DATA  90,155,302,320',"娯楽費",0   21
  943. 40340 DATA  90,155,321,339',"酒　代",0   22
  944. 40350 DATA  90,155,340,358',"車維持",0   23
  945. 40360 DATA  90,155,359,377',"教育費",0   24
  946. 40370 DATA  90,155,378,396',"雑　費",0   25
  947. 40380 DATA  90,155,397,415',"他支出",0   26
  948. 40500 '-------------------- スイッチグループ[2]
  949. 40510 '    SWN(G),SMX,SMY,SMW
  950. 40520 DATA     2 ,0.8,0.8,  0
  951. 40530 '    XB1 XB2 YB1 YB2 SWM$         SMC
  952. 40540 DATA 552,583, 56, 73',"  OK  ",1   01
  953. 40550 DATA 584,615, 56, 73',"  NG  ",1   02
  954. 40600 '-------------------- スイッチグループ(3)
  955. 40610 '    SWN(G),SMX,SMY,SMW
  956. 40620 DATA    21 ,0.6,0.8,  0
  957. 40630 '    XB1 XB2 YB1 YB2 SWM$         SMC
  958. 40640 DATA  20, 49,156,174' ,"終了",2
  959. 40650 DATA  50, 79,156,174' ,"取消",1
  960. 40660 DATA  80,115,156,174' ,"ｷｰ入力",0
  961. 40670 DATA 116,132,156,174' ,"▼",5
  962. 40680 DATA 133,149,156,174' ,"▲",5
  963. 40690 DATA 117,149,186,199' ,"",1
  964. 40700 DATA 117,149,200,213' ,"",1
  965. 40710 DATA 117,149,214,227' ,"",1
  966. 40720 DATA 117,149,228,241' ,"",1
  967. 40730 DATA 117,149,242,255' ,"",1
  968. 40740 DATA 117,149,256,269' ,"",1
  969. 40750 DATA 117,149,270,283' ,"",1
  970. 40760 DATA 117,149,284,297' ,"",1
  971. 40770 DATA 117,149,298,311' ,"",1
  972. 40780 DATA 117,149,312,325' ,"",1
  973. 40790 DATA 117,149,326,339' ,"",1
  974. 40800 DATA 117,149,340,353' ,"",1
  975. 40810 DATA 117,149,354,367' ,"",1
  976. 40820 DATA 117,149,368,381' ,"",1
  977. 40830 DATA 117,149,382,395' ,"",1
  978. 40840 DATA 117,149,396,409' ,"",1
  979. 60000 '
  980. 60010 ' 座標確認 DEBUG ROUTINE
  981. 60020 '
  982. 60030 MOUSE 0:MOUSE 1,0,0,1
  983. 60040  IF MOUSE(2,1)<>0 THEN STOP
  984. 60050  IF MOUSE(2,0)=0 THEN 60050
  985. 60060  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):LX=INT(X_M/8):LY=INT(Y_M/19)
  986. 60070  LOCATE 2,24:COLOR 7:PRINT "X=";X_M,"Y=";Y_M,"LX=";LX,"LY=";LY;
  987. 60080  GOTO 60040
  988. 61000 ' 
  989.